Study 1

study_1_data <- read_csv(here("data/study-1_tidy_data.csv")) %>%
  mutate(
    relationship = factor(
      relationship,
      levels = c("No info", "Symmetric", "Asymmetric")
    ),
    next_interaction = factor(
      next_interaction,
      levels = c("Reciprocity", "Precedent", "None")
    )
  )
## Rows: 3186 Columns: 6
## ── Column specification ──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────
## Delimiter: ","
## chr (4): subject_id, story, relationship, next_interaction
## dbl (2): likert_rating, normalized_likert_rating
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
study_1_summary <- study_1_data %>%
  group_by(relationship, next_interaction) %>%
  tidyboot_mean(likert_rating, na.rm = T)
## Warning: There was 1 warning in `dplyr::mutate()`.
## ℹ In argument: `strap = purrr::map(strap, dplyr::as_data_frame)`.
## Caused by warning:
## ! `as_data_frame()` was deprecated in tibble 2.0.0.
## ℹ Please use `as_tibble()` (with slightly different semantics) to convert to a tibble, or `as.data.frame()` to convert to a data frame.
## ℹ The deprecated feature was likely used in the purrr package.
##   Please report the issue at <https://github.com/tidyverse/purrr/issues>.
## Warning: `cols` is now required when using `unnest()`.
## ℹ Please use `cols = c(strap)`.
study_1_summary_scenario <- study_1_data %>%
  group_by(relationship, next_interaction, story) %>%
  tidyboot_mean(likert_rating, na.rm = T)
## Warning: `cols` is now required when using `unnest()`.
## ℹ Please use `cols = c(strap)`.
ggplot(
  study_1_data,
  aes(x = relationship, y = likert_rating, fill = next_interaction)
) +
  geom_violin(
    bw = 0.43,
    position = position_dodge(width = 0.7),
    alpha = 0.8
  ) +
  geom_pointrange(
    data = study_1_summary,
    aes(
      x = relationship,
      y = empirical_stat,
      ymin = ci_lower,
      ymax = ci_upper
    ),
    size = 0.3,
    linewidth = 1,
    position = position_dodge(width = 0.7)
  ) +
  scale_fill_manual(values = action_colors) +
  scale_color_manual(values = action_colors) +
  scale_y_continuous(breaks = c(1, 2, 3, 4, 5, 6, 7)) +
  labs(
    title = "Study 1: Equal vs. hierarchical",
    x = "Relationship",
    y = "How likely?",
    fill = "Next interaction"
  ) +
  theme(legend.position = "bottom")
## Warning: Removed 7 rows containing non-finite outside the scale range
## (`stat_ydensity()`).

ggsave(here("figures/study-1_main.pdf"))
## Saving 6 x 3.5 in image
## Warning: Removed 7 rows containing non-finite outside the scale range
## (`stat_ydensity()`).
ggplot(
  study_1_data,
  aes(x = relationship, y = likert_rating, fill = next_interaction)
) +
  geom_violin(
    bw = 0.43,
    position = position_dodge(width = 0.7),
    alpha = 0.8
  ) +
  geom_pointrange(
    data = study_1_summary_scenario,
    aes(
      x = relationship,
      y = empirical_stat,
      ymin = ci_lower,
      ymax = ci_upper
    ),
    size = 0.3,
    linewidth = 1,
    position = position_dodge(width = 0.7)
  ) +
  scale_fill_manual(values = action_colors) +
  scale_color_manual(values = action_colors) +
  scale_y_continuous(breaks = c(1, 2, 3, 4, 5, 6, 7)) +
  labs(
    title = "Study 1: Equal vs. hierarchical",
    x = "Relationship",
    y = "How likely?",
    fill = "Next interaction"
  ) +
  theme(legend.position = "bottom") +
  facet_wrap(~story, nrow = 6)
## Warning: Removed 7 rows containing non-finite outside the scale range
## (`stat_ydensity()`).

# ggsave(here("figures/study-1_scenarios.pdf"))

Study 2

study_2_data <- read_csv(here("data/study-2_tidy_data.csv")) %>%
  mutate(
    relationship = factor(
      relationship,
      levels = c("Equal", "Lower", "Higher")
    ),
    next_interaction = factor(
      next_interaction,
      levels = c("Reciprocity", "Precedent", "None")
    )
  )
## Rows: 3186 Columns: 16
## ── Column specification ──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────
## Delimiter: ","
## chr  (4): subject_id, story, relationship, next_interaction
## dbl (12): likert_rating, normalized_likert_rating, n_benefit, n_effort, diff...
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
study_2_summary <- study_2_data %>%
  group_by(relationship, next_interaction) %>%
  tidyboot_mean(likert_rating, na.rm = T)
## Warning: `cols` is now required when using `unnest()`.
## ℹ Please use `cols = c(strap)`.
study_2_summary_scenario <- study_2_data %>%
  group_by(relationship, next_interaction, story) %>%
  tidyboot_mean(likert_rating, na.rm = T)
## Warning: `cols` is now required when using `unnest()`.
## ℹ Please use `cols = c(strap)`.
ggplot(
  study_2_data,
  aes(x = relationship, y = likert_rating, fill = next_interaction)
) +
  geom_violin(
    bw = 0.43,
    position = position_dodge(width = 0.7),
    alpha = 0.8
  ) +
  geom_pointrange(
    data = study_2_summary,
    aes(
      x = relationship,
      y = empirical_stat,
      ymin = ci_lower,
      ymax = ci_upper
    ),
    size = 0.3,
    linewidth = 1,
    position = position_dodge(width = 0.7)
  ) +
  scale_fill_manual(values = action_colors) +
  scale_color_manual(values = action_colors) +
  scale_y_continuous(breaks = c(1, 2, 3, 4, 5, 6, 7)) +
  labs(
    title = "Study 2: Relative rank",
    x = "Rank of generous character",
    y = "How likely?",
    fill = "Next interaction"
  ) +
  theme(legend.position = "bottom")
## Warning: Removed 12 rows containing non-finite outside the scale range
## (`stat_ydensity()`).

# ggsave(here("figures/study-2_main.pdf"))
ggplot(
  study_2_data,
  aes(x = relationship, y = likert_rating, fill = next_interaction)
) +
  geom_violin(
    bw = 0.43,
    position = position_dodge(width = 0.7),
    alpha = 0.8
  ) +
  geom_pointrange(
    data = study_2_summary_scenario,
    aes(
      x = relationship,
      y = empirical_stat,
      ymin = ci_lower,
      ymax = ci_upper
    ),
    size = 0.3,
    linewidth = 1,
    position = position_dodge(width = 0.7)
  ) +
  scale_fill_manual(values = action_colors) +
  scale_color_manual(values = action_colors) +
  scale_y_continuous(breaks = c(1, 2, 3, 4, 5, 6, 7)) +
  labs(
    title = "Study 2: Relative rank",
    x = "Rank of generous character",
    y = "How likely?",
    fill = "Next interaction"
  ) +
  theme(legend.position = "bottom") +
  facet_wrap(~story, nrow = 6)
## Warning: Removed 12 rows containing non-finite outside the scale range
## (`stat_ydensity()`).

# ggsave(here("figures/study-2_scenarios.pdf"))

Validation study

TODO: Move from other R script

Effect size benefit over effort

study_2_benefit_effort <- read.csv(here("data/study-2_benefit_effort.csv")) %>%
  rename(
    diff_x = diff,
    ci_lower_x = ci_lower,
    ci_upper_x = ci_upper
  ) %>%
  mutate(relationship = factor(relationship, levels = c("Lower", "Higher")))
study_2_benefit_effort_summary <- study_2_benefit_effort %>%
  group_by(story, relationship, type, diff_x, ci_lower_x, ci_upper_x) %>%
  tidyboot_mean(p_prec, na.rm = TRUE) %>%
  rename(p_prec = empirical_stat)
## Warning: `cols` is now required when using `unnest()`.
## ℹ Please use `cols = c(strap)`.
appender <- function(string, suffix = "-rank generous") paste0(string, suffix)

ggplot(study_2_benefit_effort_summary %>% filter(type == "benefit"), aes(x = diff_x, y = p_prec, color = relationship)) +
  geom_point(size = 3, alpha = 0.3) +
  geom_smooth(method = "lm", fill = "lightgray") +
  geom_errorbar(mapping = aes(x = diff_x, ymin = ci_lower, ymax = ci_upper), size = 1.5, width = 0.13, alpha = 0.3) +
  geom_errorbarh(mapping = aes(y = p_prec, xmin = ci_lower_x, xmax = ci_upper_x), size = 1.5, height = 0.015, alpha = 0.3) +
  geom_hline(yintercept = 0.5, linetype = "dashed", color = "gray") +
  scale_color_manual(values = c("Higher" = "#DC267F", "Lower" = "#785EF0")) +
  labs(
    x = "Differential benefit",
    y = "P(Precedent)",
    title = "Study 2: Differential benefit vs. likelihood of a precedent"
  ) +
  theme(legend.position = "none") +
  facet_grid(~relationship, labeller = as_labeller(appender))
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was generated.
## `geom_smooth()` using formula = 'y ~ x'

ggsave(here("figures/study-2_benefit.pdf"))
## Saving 7 x 4 in image
## `geom_smooth()` using formula = 'y ~ x'
ggplot(study_2_benefit_effort_summary %>% filter(type == "effort"), aes(x = diff_x, y = p_prec, color = relationship)) +
  geom_point(size = 3, alpha = 0.3) +
  geom_smooth(method = "lm", fill = "lightgray") +
  geom_errorbar(mapping = aes(x = diff_x, ymin = ci_lower, ymax = ci_upper), size = 1.5, width = 0.13, alpha = 0.3) +
  geom_errorbarh(mapping = aes(y = p_prec, xmin = ci_lower_x, xmax = ci_upper_x), size = 1.5, height = 0.015, alpha = 0.3) +
  geom_hline(yintercept = 0.5, linetype = "dashed", color = "gray") +
  scale_color_manual(values = c("Higher" = "#DC267F", "Lower" = "#785EF0")) +
  labs(
    x = "Differential effort",
    y = "P(Precedent)",
    title = "Study 2: Differential effort vs. likelihood of a precedent"
  ) +
  theme(legend.position = "none") +
  facet_grid(~relationship, labeller = as_labeller(appender))
## `geom_smooth()` using formula = 'y ~ x'

ggsave(here("figures/study-2_effort.pdf"))
## Saving 7 x 4 in image
## `geom_smooth()` using formula = 'y ~ x'

Study 3

study_3_data <- read_csv(here("data/study-3_tidy_data.csv")) %>%
  mutate(
    relationship = factor(
      relationship,
      levels = c("Equal", "Lower", "Higher")
    ),
    next_interaction = factor(
      next_interaction,
      levels = c("Reciprocity", "Precedent", "None")
    )
  )
## Rows: 3078 Columns: 24
## ── Column specification ──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────
## Delimiter: ","
## chr  (5): subject_id, story, relationship, next_interaction, concrete_relati...
## dbl (19): likert_rating, normalized_likert_rating, conflict, coercion, impor...
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
study_3_summary <- study_3_data %>%
  group_by(relationship, next_interaction) %>%
  tidyboot_mean(likert_rating, na.rm = T)
## Warning: `cols` is now required when using `unnest()`.
## ℹ Please use `cols = c(strap)`.
study_3_summary_scenario <- study_3_data %>%
  group_by(relationship, next_interaction, story) %>%
  tidyboot_mean(likert_rating, na.rm = T)
## Warning: `cols` is now required when using `unnest()`.
## ℹ Please use `cols = c(strap)`.
ggplot(
  study_3_data,
  aes(x = relationship, y = likert_rating, fill = next_interaction)
) +
  geom_violin(
    bw = 0.43,
    position = position_dodge(width = 0.7),
    alpha = 0.8
  ) +
  geom_pointrange(
    data = study_3_summary,
    aes(
      x = relationship,
      y = empirical_stat,
      ymin = ci_lower,
      ymax = ci_upper
    ),
    size = 0.3,
    linewidth = 1,
    position = position_dodge(width = 0.7)
  ) +
  scale_fill_manual(values = action_colors) +
  scale_color_manual(values = action_colors) +
  scale_y_continuous(breaks = c(1, 2, 3, 4, 5, 6, 7)) +
  labs(
    title = "Study 3: Concrete relationships",
    x = "Rank of generous character",
    y = "How likely?",
    fill = "Next interaction"
  ) +
  theme(legend.position = "bottom")
## Warning: Removed 14 rows containing non-finite outside the scale range
## (`stat_ydensity()`).

# ggsave(here("figures/study-4_main.pdf"))
ggplot(
  study_3_data,
  aes(x = relationship, y = likert_rating, fill = next_interaction)
) +
  geom_violin(
    bw = 0.43,
    position = position_dodge(width = 0.7),
    alpha = 0.8
  ) +
  geom_pointrange(
    data = study_3_summary_scenario,
    aes(
      x = relationship,
      y = empirical_stat,
      ymin = ci_lower,
      ymax = ci_upper
    ),
    size = 0.3,
    linewidth = 1,
    position = position_dodge(width = 0.7)
  ) +
  scale_fill_manual(values = action_colors) +
  scale_color_manual(values = action_colors) +
  scale_y_continuous(breaks = c(1, 2, 3, 4, 5, 6, 7)) +
  labs(
    title = "Study 3: Concrete relationships",
    x = "Rank of generous character",
    y = "How likely?",
    fill = "Next interaction"
  ) +
  theme(legend.position = "bottom") +
  facet_wrap(~story, nrow = 6)
## Warning: Removed 14 rows containing non-finite outside the scale range
## (`stat_ydensity()`).

ggsave(here("figures/study-3_scenarios.pdf"))
## Saving 10 x 10.5 in image
## Warning: Removed 14 rows containing non-finite outside the scale range
## (`stat_ydensity()`).

Effect size benefit over effort

study_3_benefit_effort <- read.csv(here("data/study-3_benefit_effort.csv")) %>%
  rename(
    diff_x = diff,
    ci_lower_x = ci_lower,
    ci_upper_x = ci_upper
  ) %>%
  mutate(relationship = factor(relationship, levels = c("Lower", "Higher")))
study_3_benefit_effort_summary <- study_3_benefit_effort %>%
  group_by(story, relationship, type, diff_x, ci_lower_x, ci_upper_x) %>%
  tidyboot_mean(p_prec, na.rm = TRUE) %>%
  rename(p_prec = empirical_stat)
## Warning: `cols` is now required when using `unnest()`.
## ℹ Please use `cols = c(strap)`.
appender <- function(string, suffix = "-rank generous") paste0(string, suffix)

ggplot(study_3_benefit_effort_summary %>% filter(type == "benefit"), aes(x = diff_x, y = p_prec, color = relationship)) +
  geom_point(size = 3, alpha = 0.3) +
  geom_smooth(method = "lm", fill = "lightgray") +
  geom_errorbar(mapping = aes(x = diff_x, ymin = ci_lower, ymax = ci_upper), size = 1.5, width = 0.13, alpha = 0.3) +
  geom_errorbarh(mapping = aes(y = p_prec, xmin = ci_lower_x, xmax = ci_upper_x), size = 1.5, height = 0.015, alpha = 0.3) +
  geom_hline(yintercept = 0.5, linetype = "dashed", color = "gray") +
  scale_color_manual(values = c("Higher" = "#DC267F", "Lower" = "#785EF0")) +
  labs(
    x = "Differential benefit",
    y = "P(Precedent)",
    title = "Study 3: Differential benefit vs. likelihood of a precedent"
  ) +
  theme(legend.position = "none") +
  facet_grid(~relationship, labeller = as_labeller(appender))
## `geom_smooth()` using formula = 'y ~ x'

ggsave(here("figures/study-3_benefit.pdf"))
## Saving 7 x 4 in image
## `geom_smooth()` using formula = 'y ~ x'
ggplot(study_3_benefit_effort_summary %>% filter(type == "effort"), aes(x = diff_x, y = p_prec, color = relationship)) +
  geom_point(size = 3, alpha = 0.3) +
  geom_smooth(method = "lm", fill = "lightgray") +
  geom_errorbar(mapping = aes(x = diff_x, ymin = ci_lower, ymax = ci_upper), size = 1.5, width = 0.13, alpha = 0.3) +
  geom_errorbarh(mapping = aes(y = p_prec, xmin = ci_lower_x, xmax = ci_upper_x), size = 1.5, height = 0.015, alpha = 0.3) +
  geom_hline(yintercept = 0.5, linetype = "dashed", color = "gray") +
  scale_color_manual(values = c("Higher" = "#DC267F", "Lower" = "#785EF0")) +
  labs(
    x = "Differential effort",
    y = "P(Precedent)",
    title = "Study 3: Differential effort vs. likelihood of a precedent"
  ) +
  theme(legend.position = "none") +
  facet_grid(~relationship, labeller = as_labeller(appender))
## `geom_smooth()` using formula = 'y ~ x'

ggsave(here("figures/study-3_effort.pdf"))
## Saving 7 x 4 in image
## `geom_smooth()` using formula = 'y ~ x'

Study 4

study_4_data <- read_csv(here("data/study-4_tidy_data.csv")) %>%
  mutate(
    first_actual = factor(
      first_actual,
      levels = c("Equal", "Lower", "Higher")
    ),
    first_response = factor(
      first_response,
      levels = c("Equal", "Lower", "Higher")
    )
  ) %>% mutate(
    Expectations = factor(Expectations, levels = c("Consistent", "Inconsistent"))
  )
## Rows: 2034 Columns: 18
## ── Column specification ──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────
## Delimiter: ","
## chr  (8): subject_id, story, first_actual, strategy, first_response, second_...
## dbl (10): n_benefit, n_effort, diff_benefit, diff_effort, ci_lower_benefit, ...
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
# Implicit coordination
study_4_first_time_summary <-
  study_4_data %>%
  mutate(first_response = recode(first_response, "Higher" = 0, "Lower" = 1)) %>%
  group_by(story, diff_effort, ci_lower_effort, ci_upper_effort, diff_benefit, ci_lower_benefit, ci_upper_benefit) %>%
  tidyboot_mean(first_response, na.rm = TRUE)
## Warning: `cols` is now required when using `unnest()`.
## ℹ Please use `cols = c(strap)`.
d.temp <- study_4_first_time_summary %>%
  arrange(desc(mean))

levs <- unique(d.temp$story)

study_4_first_time_summary$story <-
  factor(study_4_first_time_summary$story, levels = levs)


# First vs. second time
study_4_second_summary <-
  study_4_data %>%
  filter(symmetric == "Asymmetric") %>%
  mutate(second_response = recode(second_response, "Higher" = 0, "Lower" = 1)) %>%
  group_by(story, first_actual) %>%
  tidyboot_mean(second_response, na.rm = TRUE)
## Warning: `cols` is now required when using `unnest()`.
## ℹ Please use `cols = c(strap)`.
study_4_first_second_summary <-
  left_join(
    study_4_first_time_summary,
    study_4_second_summary,
    suffix = c("_first", "_second"),
    by = (c("story"))
  )

Do we replicate the previous results?

study_4_summary <- study_4_data %>%
  mutate(strategy = recode(
    strategy,
    "Precedent" = 1,
    "Reciprocity" = 0
  )) %>%
  group_by(first_response, first_actual, Expectations) %>%
  tidyboot_mean(strategy, na.rm = TRUE)
## Warning: `cols` is now required when using `unnest()`.
## ℹ Please use `cols = c(strap)`.
ggplot(study_4_summary, aes(x = first_actual, y = empirical_stat, color = first_actual, shape = Expectations)) +
  geom_pointrange(
    aes(ymin = ci_lower, ymax = ci_upper),
    size = 1.0,
    linewidth = 1.8,
    position = position_dodge(width = 0.2),
  ) +
  geom_hline(yintercept = 0.5, linetype = "dashed", color = "gray") +
  scale_color_manual(values = relationship_colors, guide = "none") +
  scale_shape_discrete(name = "First time prediction") +
  scale_y_continuous(limits = c(0, 1)) +
  labs(
    x = "Rank of generous actor",
    y = "P(Precedent)"
  ) +
  theme(legend.position = "right")

ggsave(here("figures/study-4_main.pdf"))
## Saving 6 x 3.2 in image

Implicit cooordination

First time plots

ggplot(study_4_first_time_summary, aes(x = story, y = empirical_stat)) +
  geom_pointrange(
    data = study_4_first_time_summary,
    aes(
      x = story,
      y = empirical_stat,
      ymin = ci_lower,
      ymax = ci_upper
    ),
    size = 0.7,
    linewidth = 1.5
  ) +
  geom_hline(
    yintercept = 0.5,
    linetype = "dashed",
    color = "gray",
    alpha = 0.5
  ) +
  scale_y_continuous(limits = c(0, 1)) +
  labs(x = "Scenario", y = "P(lower-rank generous)", title = "Study 3: Implicit coordination") +
  theme(axis.text.x = element_text(angle = 30, hjust = 1))

ggsave(here("figures/study-4_implicit.pdf"))
## Saving 8 x 3.5 in image

Correlate benefit and effort with implicit coordination expectations

ggplot(study_4_first_second_summary, aes(x = diff_effort, y = empirical_stat_first)) +
  geom_point(size = 3, alpha = 0.3) +
  geom_smooth(method = "lm", fill = "lightgray") +
  geom_errorbar(mapping = aes(x = diff_effort, ymin = ci_lower_first, ymax = ci_upper_first), size = 1.5, width = 0.11, alpha = 0.3) +
  geom_errorbarh(mapping = aes(y = empirical_stat_first, xmin = ci_lower_effort, xmax = ci_upper_effort), size = 1.5, height = 0.03, alpha = 0.3) +
  geom_hline(yintercept = 0.5, linetype = "dashed", color = "gray") +
  lims(y = c(0, 1)) +
  labs(
    x = "Differential effort",
    y = "P(Lower-ranked generous)"
  ) +
  theme(legend.position = "none")
## `geom_smooth()` using formula = 'y ~ x'

ggsave(here("figures/study-4_effort-first-time.pdf"))
## Saving 4.5 x 4 in image
## `geom_smooth()` using formula = 'y ~ x'
ggplot(study_4_first_second_summary, aes(x = diff_benefit, y = empirical_stat_first)) +
  geom_point(size = 3, alpha = 0.3) +
  geom_smooth(method = "lm", fill = "lightgray") +
  geom_errorbar(mapping = aes(x = diff_benefit, ymin = ci_lower_first, ymax = ci_upper_first), size = 1.5, width = 0.11, alpha = 0.3) +
  geom_errorbarh(mapping = aes(y = empirical_stat_first, xmin = ci_lower_benefit, xmax = ci_upper_benefit), size = 1.5, height = 0.03, alpha = 0.3) +
  geom_hline(yintercept = 0.5, linetype = "dashed", color = "gray") +
  lims(y = c(0, 1)) +
  labs(
    x = "Differential benefit",
    y = "P(Lower-ranked generous)"
  ) +
  theme(legend.position = "none")
## `geom_smooth()` using formula = 'y ~ x'

ggsave(here("figures/study-4_benefit-first-time.pdf"))
## Saving 4.5 x 4 in image
## `geom_smooth()` using formula = 'y ~ x'

Main plot: First time vs. second time

ggplot(
  study_4_first_second_summary,
  aes(x = empirical_stat_first, y = empirical_stat_second, color = first_actual)
) +
  geom_smooth(
    method = "lm",
    fill = "lightgray",
    linewidth = 1.3
  ) +
  geom_point(
    size = 3.6,
    alpha = 0.3,
    stroke = 0
  ) +
  geom_errorbar(
    mapping = aes(x = empirical_stat_first, ymin = ci_lower_second, ymax = ci_upper_second),
    size = 1.5,
    width = 0.03,
    alpha = 0.3
  ) +
  geom_errorbarh(
    mapping = aes(y = empirical_stat_second, xmin = ci_lower_first, xmax = ci_upper_first),
    size = 1.5,
    height = 0.03,
    alpha = 0.3
  ) +
  geom_hline(
    yintercept = 0.5,
    linetype = "dashed",
    color = "gray"
  ) +
  geom_vline(
    xintercept = 0.5,
    linetype = "dashed",
    color = "gray"
  ) +
  scale_y_continuous(limits = c(0, 1)) +
  scale_x_continuous(limits = c(0, 1)) +
  scale_color_manual(values = c("Higher" = "#DC267F", "Lower" = "#785EF0")) +
  labs(x = "Expected first time (Study 4)", y = "Predicted next time (Study 4)", color = "Observed rank of generous actor") +
  theme(legend.position = "bottom")
## `geom_smooth()` using formula = 'y ~ x'

ggsave(here("figures/study-4_first_second.pdf"))
## Saving 4.5 x 4.5 in image
## `geom_smooth()` using formula = 'y ~ x'

Study 4 vs. Study 2

study_2_first_second <- study_2_data %>%
  filter(relationship != "Equal", next_interaction != "None") %>%
  group_by(subject_id, story, relationship) %>%
  mutate(
    total_rating = sum(likert_rating),
    normalized_likert_rating = likert_rating / total_rating
  ) %>%
  select(-total_rating) %>%
  ungroup() %>%
  rename(first_actual = relationship) %>%
  mutate(
    second_response = case_when(
      next_interaction == "Precedent" ~ first_actual,
      next_interaction == "Reciprocity" ~ ifelse(first_actual == "Higher", "Lower", "Higher"),
      next_interaction == "None" ~ "None"
    )
  )


study_2_first_second_summary <- study_2_first_second %>%
  filter(second_response == "Lower") %>%
  group_by(story, first_actual) %>%
  tidyboot_mean(normalized_likert_rating, na.rm = T)
## Warning: `cols` is now required when using `unnest()`.
## ℹ Please use `cols = c(strap)`.
studies_2_4_summary <-
  left_join(
    study_2_first_second_summary,
    study_4_first_time_summary,
    suffix = c("_2", "_4"),
    by = (c("story"))
  )
ggplot(
  studies_2_4_summary,
  aes(x = empirical_stat_4, y = empirical_stat_2, color = first_actual)
) +
  geom_point(
    size = 3.3,
    alpha = 0.3,
    stroke = 0
  ) +
  geom_smooth(
    method = "lm",
    fill = "lightgray",
    linewidth = 1.3
  ) +
  geom_errorbar(
    mapping = aes(x = empirical_stat_4, ymin = ci_lower_2, ymax = ci_upper_2),
    size = 1.5,
    width = 0.03,
    alpha = 0.3
  ) +
  geom_errorbarh(
    mapping = aes(y = empirical_stat_2, xmin = ci_lower_4, xmax = ci_upper_4),
    size = 1.5,
    height = 0.03,
    alpha = 0.3
  ) +
  geom_hline(
    yintercept = 0.5,
    linetype = "dashed",
    color = "gray"
  ) +
  geom_vline(
    xintercept = 0.5,
    linetype = "dashed",
    color = "gray"
  ) +
  scale_y_continuous(limits = c(0.2, 0.8)) +
  scale_x_continuous(limits = c(0, 1)) +
  scale_color_manual(values = c("Higher" = "#DC267F", "Lower" = "#785EF0")) +
  labs(x = "Expected first time (Study 4)", y = "Predicted next time (Study 2)", color = "Observed rank of generous actor") +
  theme(legend.position = "bottom")
## `geom_smooth()` using formula = 'y ~ x'

ggsave(here("figures/study-2-4_first_second.pdf"))
## Saving 4.5 x 4.5 in image
## `geom_smooth()` using formula = 'y ~ x'

Study 4 vs. Study 3 (concrete relationships)

study_3_first_second <- study_3_data %>%
  filter(relationship != "Equal", next_interaction != "None") %>%
  group_by(subject_id, story, relationship) %>%
  mutate(
    total_rating = sum(likert_rating),
    normalized_likert_rating = likert_rating / total_rating
  ) %>%
  select(-total_rating) %>%
  ungroup() %>%
  rename(first_actual = relationship) %>%
  mutate(
    second_response = case_when(
      next_interaction == "Precedent" ~ first_actual,
      next_interaction == "Reciprocity" ~ ifelse(first_actual == "Higher", "Lower", "Higher"),
      next_interaction == "None" ~ "None"
    )
  )

study_3_first_second_summary <- study_3_first_second %>%
  filter(second_response == "Lower") %>%
  group_by(story, first_actual, prestige_score, dominance_score) %>%
  tidyboot_mean(normalized_likert_rating, na.rm = T)
## Warning: `cols` is now required when using `unnest()`.
## ℹ Please use `cols = c(strap)`.
studies_3_4_summary <-
  left_join(
    study_3_first_second_summary,
    study_4_first_time_summary,
    suffix = c("_3", "_4"),
    by = (c("story"))
  )

studies_3_4_all <-
  left_join(
    study_3_first_second,
    study_4_first_time_summary,
    suffix = c("_3", "_4"),
    by = (c("story", "diff_benefit", "ci_lower_benefit", "ci_upper_benefit", "diff_effort", "ci_lower_effort", "ci_upper_effort"))
  ) %>%
  rename(expected.first.3 = empirical_stat, expected.next.4 = normalized_likert_rating) %>%
  filter(second_response == "Lower")
ggplot(
  studies_3_4_summary,
  aes(x = empirical_stat_4, y = empirical_stat_3, color = first_actual)
) +
  geom_point(
    size = 3.3,
    alpha = 0.3,
    stroke = 0
  ) +
  geom_smooth(
    method = "lm",
    fill = "lightgray",
    linewidth = 1.3
  ) +
  geom_errorbar(
    mapping = aes(x = empirical_stat_4, ymin = ci_lower_3, ymax = ci_upper_3),
    size = 1.5,
    width = 0.03,
    alpha = 0.3
  ) +
  geom_errorbarh(
    mapping = aes(y = empirical_stat_3, xmin = ci_lower_4, xmax = ci_upper_4),
    size = 1.5,
    height = 0.03,
    alpha = 0.3
  ) +
  geom_hline(
    yintercept = 0.5,
    linetype = "dashed",
    color = "gray"
  ) +
  geom_vline(
    xintercept = 0.5,
    linetype = "dashed",
    color = "gray"
  ) +
  scale_y_continuous(limits = c(0.2, 0.8)) +
  scale_x_continuous(limits = c(0, 1)) +
  scale_color_manual(values = c("Higher" = "#DC267F", "Lower" = "#785EF0")) +
  labs(x = "Expected first time (Study 4)", y = "Predicted next time (Study 3)", color = "Observed rank of generous actor") +
  theme(legend.position = "bottom")
## `geom_smooth()` using formula = 'y ~ x'

ggsave(here("figures/study-3-4_first_second.pdf"))
## Saving 4.5 x 4.5 in image
## `geom_smooth()` using formula = 'y ~ x'
ggplot(
  studies_3_4_summary,
  aes(x = prestige_score, y = empirical_stat_3, color = first_actual)
) +
  geom_point(
    size = 3.3,
    alpha = 0.3,
    stroke = 0
  ) +
  geom_smooth(
    method = "lm",
    fill = "lightgray",
    linewidth = 1.3
  ) +
  geom_errorbar(
    mapping = aes(x = prestige_score, ymin = ci_lower_3, ymax = ci_upper_3),
    size = 1.5,
    width = 0.03,
    alpha = 0.3
  ) +
  geom_hline(
    yintercept = 0.5,
    linetype = "dashed",
    color = "gray"
  ) +
  scale_y_continuous(limits = c(0.2, 0.8)) +
  scale_color_manual(values = c("Higher" = "#DC267F", "Lower" = "#785EF0")) +
  labs(x = "Prestige score", y = "Study 3 P(lower-rank generous)", color = "Observed rank of generous actor") +
  theme(legend.position = "none")
## `geom_smooth()` using formula = 'y ~ x'

ggsave(here("figures/study-3_prestige.pdf"))
## Saving 4 x 4 in image
## `geom_smooth()` using formula = 'y ~ x'
ggplot(
  studies_3_4_summary,
  aes(x = dominance_score, y = empirical_stat_3, color = first_actual)
) +
  geom_point(
    size = 3.3,
    alpha = 0.3,
    stroke = 0
  ) +
  geom_smooth(
    method = "lm",
    fill = "lightgray",
    linewidth = 1.3
  ) +
  geom_errorbar(
    mapping = aes(x = dominance_score, ymin = ci_lower_3, ymax = ci_upper_3),
    size = 1.5,
    width = 0.03,
    alpha = 0.3
  ) +
  geom_hline(
    yintercept = 0.5,
    linetype = "dashed",
    color = "gray"
  ) +
  scale_y_continuous(limits = c(0.2, 0.8)) +
  scale_color_manual(values = c("Higher" = "#DC267F", "Lower" = "#785EF0")) +
  labs(x = "Dominance score", y = "Study 3 P(lower-rank generous)", color = "Observed rank of generous actor") +
  theme(legend.position = "none")
## `geom_smooth()` using formula = 'y ~ x'

ggsave(here("figures/study-3_dominance.pdf"))
## Saving 4 x 4 in image
## `geom_smooth()` using formula = 'y ~ x'

plot correlation of dominance score vs. prestige score

ggplot(studies_3_4_summary, aes(x = dominance_score, y = prestige_score)) +
  geom_point(size = 2.5) +
  geom_smooth(method = "lm", fill = "lightgray", linewidth = 1.3) +
  labs(x = "Dominance score", y = "Prestige score")
## `geom_smooth()` using formula = 'y ~ x'

ggsave(here("figures/dominance_vs_prestige.pdf"))
## Saving 4 x 4 in image
## `geom_smooth()` using formula = 'y ~ x'
cor.test(studies_3_4_summary$dominance_score, studies_3_4_summary$prestige_score, method = "pearson")
## 
##  Pearson's product-moment correlation
## 
## data:  studies_3_4_summary$dominance_score and studies_3_4_summary$prestige_score
## t = 1.3814, df = 34, p-value = 0.1762
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.1060351  0.5197058
## sample estimates:
##       cor 
## 0.2305315

Plot ‘first time’ with dominance score, see how much they are related

studies_3_4_lower_summary <- studies_3_4_summary %>%
  filter(first_actual == "Lower") 

studies_3_4_higher_summary <- studies_3_4_summary %>%
  filter(first_actual == "Higher")

Correlation of dominance score vs. first time P(lower-rank generous)

cor.test(studies_3_4_lower_summary$dominance_score, studies_3_4_lower_summary$empirical_stat_4, method = "pearson")
## 
##  Pearson's product-moment correlation
## 
## data:  studies_3_4_lower_summary$dominance_score and studies_3_4_lower_summary$empirical_stat_4
## t = 0.71697, df = 16, p-value = 0.4837
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.3165104  0.5943445
## sample estimates:
##       cor 
## 0.1764307

Correlation of prestige score vs. first time P(lower-rank generous)

cor.test(studies_3_4_higher_summary$prestige_score, studies_3_4_higher_summary$empirical_stat_4, method = "pearson")
## 
##  Pearson's product-moment correlation
## 
## data:  studies_3_4_higher_summary$prestige_score and studies_3_4_higher_summary$empirical_stat_4
## t = -0.53666, df = 16, p-value = 0.5989
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.5647821  0.3559962
## sample estimates:
##        cor 
## -0.1329748
ggplot(
  studies_3_4_lower_summary,
  aes(x = dominance_score, y = empirical_stat_4)
) +
  geom_pointrange(
    aes(y = empirical_stat_4, ymin = ci_lower_4, ymax = ci_upper_4),
    size = 0.7,
    linewidth = 1.5
  ) +
  geom_smooth(
    method = "lm",
    fill = "lightgray",
    linewidth = 1.3
  ) +
  geom_hline(
    yintercept = 0.5,
    linetype = "dashed",
    color = "gray"
  ) +
  lims(y = c(0, 1)) +
  labs(y = "Study 4 First time P(lower-rank generous)", x = "Dominance score")
## `geom_smooth()` using formula = 'y ~ x'

ggsave(here("figures/study-4_dominance-vs-first.pdf"))
## Saving 4 x 4 in image
## `geom_smooth()` using formula = 'y ~ x'
ggplot(
  studies_3_4_higher_summary,
  aes(x = prestige_score, y = empirical_stat_4)
) +
  geom_pointrange(
    aes(y = empirical_stat_4, ymin = ci_lower_4, ymax = ci_upper_4),
    size = 0.7,
    linewidth = 1.5
  ) +
  geom_smooth(
    method = "lm",
    fill = "lightgray",
    linewidth = 1.3
  ) +
  geom_hline(
    yintercept = 0.5,
    linetype = "dashed",
    color = "gray"
  ) +
  lims(y = c(0, 1)) +
  labs(y = "Study 4 First time P(lower-rank generous)", x = "Prestige score")
## `geom_smooth()` using formula = 'y ~ x'

ggsave(here("figures/study-4_prestige-vs-first.pdf"))
## Saving 4 x 4 in image
## `geom_smooth()` using formula = 'y ~ x'

Study 5

study_5_data <- read_csv(here("data/study-5_tidy_data.csv")) %>%
  mutate(
    participant_rank = case_when(
      partner_status == "equal" ~ "Equal",
      partner_status == "lower" ~ "Higher",
      partner_status == "higher" ~ "Lower"
    ),
    participant_rank = factor(participant_rank, levels = c("Equal", "Lower", "Higher")),
    participant_first_choice = factor(
      participant_first_choice,
      levels = c("receive", "give"),
      labels = c("Receive", "Give")
    ),
    partner_first_choice = factor(
      partner_first_choice,
      levels = c("receive", "give"),
      labels = c("Receive", "Give")
    )
  )
## Rows: 918 Columns: 15
## ── Column specification ──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────
## Delimiter: ","
## chr (9): subject_id, scenario_id, partner_status, relationship, partner_firs...
## dbl (4): participant_first_choice_generous, participant_second_choice_genero...
## lgl (2): coordination, successful_first_time
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
# Analyze first time choices by partner status
study_5_first_time_summary <- study_5_data %>%
  group_by(scenario_id, participant_rank) %>%
  tidyboot_mean(participant_first_choice_generous, na.rm = T)
## Warning: `cols` is now required when using `unnest()`.
## ℹ Please use `cols = c(strap)`.
study_5_first_time_all <- study_5_data %>%
  group_by(participant_rank) %>%
  tidyboot_mean(participant_first_choice_generous, na.rm = T)
## Warning: `cols` is now required when using `unnest()`.
## ℹ Please use `cols = c(strap)`.
ggplot(
  study_5_first_time_summary,
  aes(x = participant_rank, y = empirical_stat)
) +
  geom_pointrange(
    aes(y = empirical_stat, ymin = ci_lower, ymax = ci_upper),
    size = 0.7,
    linewidth = 1.5
  ) +
  labs(
    title = "Study 5: First time",
    x = "Self rank",
    y = "P(first time generous)"
  ) +
  geom_hline(
    yintercept = 0.5,
    linetype = "dashed",
    color = "gray"
  ) +
  scale_y_continuous(limits = c(0, 1)) +
  facet_wrap(~scenario_id) +
  theme(legend.position = "none")

ggsave(here("figures/study-5_first_time_scenarios.pdf"))
## Saving 6 x 4 in image
ggplot(
  study_5_first_time_all,
  aes(x = participant_rank, y = empirical_stat)
) +
  geom_pointrange(
    aes(y = empirical_stat, ymin = ci_lower, ymax = ci_upper),
    size = 0.7,
    linewidth = 1.5
  ) +
  labs(
    title = "Study 5: First time",
    x = "Self rank",
    y = "P(Self generous first time)",
    color = "Self rank"
  ) +
  geom_hline(
    yintercept = 0.5,
    linetype = "dashed",
    color = "gray"
  ) +
  scale_y_continuous(limits = c(0, 1)) +
  theme(legend.position = "none")

ggsave(here("figures/study-5_first_time_all.pdf"))
## Saving 2.8 x 3.2 in image
study_5_summary <- study_5_data %>%
  group_by(
    participant_rank,
    participant_first_choice,
    partner_first_choice,
    successful_first_time
  ) %>%
  tidyboot_mean(participant_second_choice_generous, na.rm = TRUE)
## Warning: `cols` is now required when using `unnest()`.
## ℹ Please use `cols = c(strap)`.

Plot coordination and miscoordination separately

ggplot(study_5_summary %>% filter(successful_first_time == TRUE), aes(x = participant_rank, y = empirical_stat, color = partner_first_choice)) +
  geom_pointrange(
    aes(y = empirical_stat, ymin = ci_lower, ymax = ci_upper),
    size = 0.7,
    linewidth = 1.5,
    position = position_dodge(width = 0.3)
  ) +
  geom_hline(
    yintercept = 0.5,
    linetype = "dashed",
    color = "gray"
  ) +
  scale_y_continuous(limits = c(0, 1)) +
  labs(
    title = "Study 5: Second time (successful first time)",
    x = "Self rank",
    y = "P(Self generous second time)",
    color = "First time generous",
    shape = "First time generous"
  ) +
  scale_color_manual(
    values = c("Receive" = "#E69F00", "Give" = "#F0E442"),
    labels = c("Receive" = "Self (Precedent)", "Give" = "Partner (Reciprocity)")
  ) +
  scale_shape_manual(
    values = c("Receive" = 16, "Give" = 17),
    labels = c("Receive" = "Self (Precedent)", "Give" = "Partner (Reciprocity)")
  )
## Warning: No shared levels found between `names(values)` of the manual scale and
## the data's shape values.

ggsave(here("figures/study-5_second_time_successful.pdf"))
## Saving 5.1 x 3.2 in image
## Warning: No shared levels found between `names(values)` of the manual scale and
## the data's shape values.
ggplot(study_5_summary %>% filter(successful_first_time == FALSE), aes(x = participant_rank, y = empirical_stat, color = partner_first_choice)) +
  geom_pointrange(
    aes(y = empirical_stat, ymin = ci_lower, ymax = ci_upper),
    size = 0.7,
    linewidth = 1.5,
    position = position_dodge(width = 0.3)
  ) +
  geom_hline(
    yintercept = 0.5,
    linetype = "dashed",
    color = "gray"
  ) +
  scale_y_continuous(limits = c(0, 1)) +
  labs(
    title = "Study 5: Second time (unsuccessful first time)",
    x = "Self rank",
    y = "P(Self generous second time)",
    color = "First time"
  ) +
  scale_color_grey(
    start = 0.4, end = 0.7,
    labels = c("Give" = "Both give", "Receive" = "Both receive")
  )

ggsave(here("figures/study-5_second_time_unsuccessful.pdf"))
## Saving 4.5 x 3.2 in image
ggplot(
  study_5_summary,
  aes(x = partner_first_choice, y = empirical_stat, color = participant_rank)
) +
  geom_pointrange(
    aes(y = empirical_stat, ymin = ci_lower, ymax = ci_upper),
    size = 0.7,
    linewidth = 1.5,
    position = position_dodge(width = 0.3)
  ) +
  geom_hline(
    yintercept = 0.5,
    linetype = "dashed",
    color = "gray"
  ) +
  scale_y_continuous(limits = c(0, 1)) +
  labs(
    title = "Study 5: Second time choices",
    x = "Observed partner first choice",
    y = "P(Second time generous)",
    color = "Self rank"
  ) +
  scale_color_manual(values = relationship_colors) +
  facet_wrap(~participant_first_choice,
    labeller = labeller(
      participant_first_choice = function(x) {
        paste("First choice:", x)
      }
    )
  ) +
  theme(legend.position = "bottom")

Study 6

study_6_data <- read_csv(here("data/study-6_tidy_data.csv")) %>%
  mutate(
    participant_rank = case_when(
      partner_status == "equal" ~ "Equal",
      partner_status == "lower" ~ "Higher",
      partner_status == "higher" ~ "Lower"
    ),
    participant_rank = factor(participant_rank, levels = c("Equal", "Lower", "Higher")),
    participant_first_choice = factor(
      participant_first_choice,
      levels = c("receive", "give"),
      labels = c("Receive", "Give")
    ),
    partner_first_choice = factor(
      partner_first_choice,
      levels = c("receive", "give"),
      labels = c("Receive", "Give")
    )
  )
## Rows: 948 Columns: 15
## ── Column specification ──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────
## Delimiter: ","
## chr (9): subject_id, scenario_id, partner_status, relationship, partner_firs...
## dbl (4): participant_first_choice_generous, participant_second_choice_genero...
## lgl (2): coordination, successful_first_time
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
# Analyze first time choices by partner status
study_6_first_time_summary <- study_6_data %>%
  group_by(scenario_id, participant_rank) %>%
  tidyboot_mean(participant_first_choice_generous, na.rm = T)
## Warning: `cols` is now required when using `unnest()`.
## ℹ Please use `cols = c(strap)`.
study_6_first_time_all <- study_6_data %>%
  group_by(participant_rank) %>%
  tidyboot_mean(participant_first_choice_generous, na.rm = T)
## Warning: `cols` is now required when using `unnest()`.
## ℹ Please use `cols = c(strap)`.
ggplot(
  study_6_first_time_summary,
  aes(x = participant_rank, y = empirical_stat)
) +
  geom_pointrange(
    aes(y = empirical_stat, ymin = ci_lower, ymax = ci_upper),
    size = 0.7,
    linewidth = 1.5
  ) +
  labs(
    title = "Study 6: First time",
    x = "Self rank",
    y = "P(First time generous)",
    color = "Self rank"
  ) +
  geom_hline(
    yintercept = 0.5,
    linetype = "dashed",
    color = "gray"
  ) +
  scale_y_continuous(limits = c(0, 1)) +
  facet_wrap(~scenario_id) +
  theme(legend.position = "none")

ggsave(here("figures/study-6_first_time_scenarios.pdf"))
## Saving 6 x 4 in image
ggplot(
  study_6_first_time_all,
  aes(x = participant_rank, y = empirical_stat)
) +
  geom_pointrange(
    aes(y = empirical_stat, ymin = ci_lower, ymax = ci_upper),
    size = 0.7,
    linewidth = 1.5
  ) +
  labs(
    title = "Study 6: First time",
    x = "Self rank",
    y = "P(Self generous first time)",
    color = "Self rank"
  ) +
  geom_hline(
    yintercept = 0.5,
    linetype = "dashed",
    color = "gray"
  ) +
  scale_y_continuous(limits = c(0, 1)) +
  theme(legend.position = "none")

ggsave(here("figures/study-6_first_time_all.pdf"))
## Saving 2.8 x 3.2 in image
study_6_summary <- study_6_data %>%
  group_by(
    participant_rank,
    participant_first_choice,
    partner_first_choice,
    successful_first_time
  ) %>%
  tidyboot_mean(participant_second_choice_generous, na.rm = TRUE)
## Warning: `cols` is now required when using `unnest()`.
## ℹ Please use `cols = c(strap)`.

Plot coordination and miscoordination separately

ggplot(study_6_summary %>% filter(successful_first_time == TRUE), aes(x = participant_rank, y = empirical_stat, color = partner_first_choice)) +
  geom_pointrange(
    aes(y = empirical_stat, ymin = ci_lower, ymax = ci_upper),
    size = 0.7,
    linewidth = 1.5,
    position = position_dodge(width = 0.3)
  ) +
  geom_hline(
    yintercept = 0.5,
    linetype = "dashed",
    color = "gray"
  ) +
  scale_y_continuous(limits = c(0, 1)) +
  labs(
    title = "Study 6: Second time (successful first time)",
    x = "Self rank",
    y = "P(Self generous second time)",
    color = "First time generous"
  ) +
  scale_color_manual(
    values = c("Receive" = "#E69F00", "Give" = "#F0E442"),
    labels = c("Receive" = "Self (Precedent)", "Give" = "Partner (Reciprocity)")
  )

ggsave(here("figures/study-6_second_time_successful.pdf"))
## Saving 5.1 x 3.2 in image
ggplot(study_6_summary %>% filter(successful_first_time == FALSE), aes(x = participant_rank, y = empirical_stat, color = partner_first_choice)) +
  geom_pointrange(
    aes(y = empirical_stat, ymin = ci_lower, ymax = ci_upper),
    size = 0.7,
    linewidth = 1.5,
    position = position_dodge(width = 0.3)
  ) +
  geom_hline(
    yintercept = 0.5,
    linetype = "dashed",
    color = "gray"
  ) +
  scale_y_continuous(limits = c(0, 1)) +
  labs(
    title = "Study 6: Second time (unsuccessful first time)",
    x = "Self rank",
    y = "P(Self generous second time)",
    color = "First time"
  ) +
  scale_color_grey(
    start = 0.4, end = 0.7,
    labels = c("Give" = "Both give", "Receive" = "Both receive")
  )

ggsave(here("figures/study-6_second_time_unsuccessful.pdf"))
## Saving 4.5 x 3.2 in image
ggplot(
  study_6_summary,
  aes(x = partner_first_choice, y = empirical_stat, color = participant_rank)
) +
  geom_pointrange(
    aes(y = empirical_stat, ymin = ci_lower, ymax = ci_upper),
    size = 0.7,
    linewidth = 1.5,
    position = position_dodge(width = 0.3)
  ) +
  geom_hline(
    yintercept = 0.5,
    linetype = "dashed",
    color = "gray"
  ) +
  scale_y_continuous(limits = c(0, 1)) +
  labs(
    title = "Study 6: Second time",
    x = "Observed partner first choice",
    y = "P(Second time generous)",
    color = "Self rank"
  ) +
  scale_color_manual(values = relationship_colors) +
  facet_wrap(~participant_first_choice,
    labeller = labeller(
      participant_first_choice = function(x) {
        paste("First choice:", x)
      }
    )
  ) +
  theme(legend.position = "bottom")